home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / 6300gray.zip / GRAY.BAS < prev    next >
BASIC Source File  |  1988-08-12  |  6KB  |  144 lines
  1. 10  REM                   %%%%%%%%%%%%%%%%%%%
  2. 15  REM                   % Function Key 10 %
  3. 20  REM                   % returns to DOS  %
  4. 25  REM                   %%%%%%%%%%%%%%%%%%%
  5. 30  KEY OFF : KEY 10,""
  6. 35  KEY (10) ON : ON KEY(10) GOSUB 675
  7. 40  SCREEN 100
  8. 45  COLOR 7
  9. 50  CLS
  10. 55  REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  11. 60  REM                   % Beginning of program to draw a gray %
  12. 65  REM                   % scale image on the screen           %
  13. 70  REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  14. 75  DEFINT I, J, N, X, Y, P
  15. 80  REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  16. 85  REM                   % I and J are FOR loop variables %
  17. 90  REM                   % N is the size of the image
  18. 95  REM                   % X and Y are SCREEN coordinates %
  19. 100 REM                   % P is to designate the PATTERN  %
  20. 105 REM                   %   arrays as integer arrays     %
  21. 110 REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  22. 115 DIM PATTERN0(3), PATTERN1(3), PATTERN2(3), PATTERN3(3)
  23. 120 DIM PATTERN4(3), PATTERN5(3), PATTERN6(3), PATTERN7(3)
  24. 125 DIM PATTERN8(3), PATTERN9(3), PATTERNA(3), PATTERNB(3)
  25. 130 DIM PATTERNC(3), PATTERND(3), PATTERNE(3), PATTERNF(3)
  26. 135 PATTERN0(0)=5 : PATTERN0(1) = 3
  27. 140 PATTERN1(0)=5 : PATTERN1(1) = 3
  28. 145 PATTERN2(0)=5 : PATTERN2(1) = 3
  29. 150 PATTERN3(0)=5 : PATTERN3(1) = 3
  30. 155 PATTERN4(0)=5 : PATTERN4(1) = 3
  31. 160 PATTERN5(0)=5 : PATTERN5(1) = 3
  32. 165 PATTERN6(0)=5 : PATTERN6(1) = 3
  33. 170 PATTERN7(0)=5 : PATTERN7(1) = 3
  34. 175 PATTERN8(0)=5 : PATTERN8(1) = 3
  35. 180 PATTERN9(0)=5 : PATTERN9(1) = 3
  36. 185 PATTERNA(0)=5 : PATTERNA(1) = 3
  37. 190 PATTERNB(0)=5 : PATTERNB(1) = 3
  38. 195 PATTERNC(0)=5 : PATTERNC(1) = 3
  39. 200 PATTERND(0)=5 : PATTERND(1) = 3
  40. 205 PATTERNE(0)=5 : PATTERNE(1) = 3
  41. 210 PATTERNF(0)=5 : PATTERNF(1) = 3
  42. 215 REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%
  43. 220 REM                   % Define the gray scale   %
  44. 225 REM                   % patterns for each array %
  45. 230 REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%
  46. 235 PATTERN0(2)=     0 : PATTERN0(3) =   0
  47. 240 PATTERN1(2)=  8192 : PATTERN1(3) =   0
  48. 245 PATTERN2(2)=  8192 : PATTERN2(3) = 128
  49. 250 PATTERN3(2)=  2176 : PATTERN3(3) =  32
  50. 255 PATTERN4(2)=  2176 : PATTERN4(3) =  80
  51. 260 PATTERN5(2)=  8336 : PATTERN5(3) =  72
  52. 265 PATTERN6(2)= 10384 : PATTERN6(3) =  80
  53. 270 PATTERN7(2)= 26768 : PATTERN7(3) =  80
  54. 275 PATTERN8(2)=NOT PATTERN7(2) : PATTERN8(3)=NOT PATTERN7(3)
  55. 280 PATTERN9(2)=NOT PATTERN6(2) : PATTERN9(3)=NOT PATTERN6(3)
  56. 285 PATTERNA(2)=NOT PATTERN5(2) : PATTERNA(3)=NOT PATTERN5(3)
  57. 290 PATTERNB(2)=NOT PATTERN4(2) : PATTERNB(3)=NOT PATTERN4(3)
  58. 295 PATTERNC(2)=NOT PATTERN3(2) : PATTERNC(3)=NOT PATTERN3(3)
  59. 300 PATTERND(2)=NOT PATTERN2(2) : PATTERND(3)=NOT PATTERN2(3)
  60. 305 PATTERNE(2)=NOT PATTERN1(2) : PATTERNE(3)=NOT PATTERN1(3)
  61. 310 PATTERNF(2)=NOT PATTERN0(2) : PATTERNF(3)=NOT PATTERN0(3)
  62. 315 REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  63. 320 REM                   % The name of the data file is assigned  %
  64. 325 REM                   % to the string variable FILENAME$. The  %
  65. 330 REM                   % data file is assumed to consist of M   %
  66. 335 REM                   % rows of N hex digits M ≤ N ≤ 128. The  %
  67. 340 REM                   % program reads the first row of data to %
  68. 345 REM                   % determine N. Once the gray scale image %
  69. 350 REM                   % of the data file has been generated it %
  70. 355 REM                   % is saved under the same name but with  %
  71. 360 REM                   % an extension of .SAV. If the corre-    %
  72. 365 REM                   % sponding .SAV file is found, then it   %
  73. 370 REM                   % is immediately displayed.              %
  74. 375 REM                   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  75. 380 INPUT; "Name of data file "; FILENAME$ : CLS
  76. 385 NAMELENGTH = LEN(FILENAME$)
  77. 390 FOR I = 1 TO 4
  78. 395   IF ASC(RIGHT$(FILENAME$,I)) = &H2E THEN NAMELENGTH = LEN(FILENAME$) - I
  79. 400 NEXT I
  80. 405 FILESAVE$ = LEFT$(FILENAME$,NAMELENGTH)+".SAV"
  81. 410 ON ERROR GOTO 655
  82. 415 DEF SEG = &HB800
  83. 420 BLOAD FILESAVE$,0
  84. 425 GOTO 425
  85. 430 OPEN FILENAME$ FOR INPUT AS #1
  86. 435 BEGIN% = 1
  87. 440 WHILE NOT EOF(1)
  88. 445 LINE INPUT #1, ROW$
  89. 450 WHILE BEGIN%
  90. 455   BEGIN% = 0
  91. 460   N = LEN(ROW$)
  92. 465   IF N > 128 THEN SYSTEM ELSE NX = INT(640/(5*N)) : NY = INT(400/(3*N))
  93. 470   DX% = 5*NX : DY% = 3*NY
  94. 475   Y = -DY%
  95. 480 WEND
  96. 485 ROWLENGTH% = LEN(ROW$) : X = -DX% : Y = Y + DY%
  97. 490 FOR JX = 1 TO ROWLENGTH%
  98. 495 HEXDIGIT$=MID$(ROW$,JX,1)
  99. 500 X = X + DX%
  100. 505 FOR I = 0 TO DX% - 1 STEP 5
  101. 510   FOR J = 0 TO DY% - 1 STEP 3
  102. 515     ON ASC(HEXDIGIT$)-&H30 GOTO 525,530,535,540,545,550,555,560,565,570,570,570,570,570,570,570,570,575,580,585,590,595
  103. 520     PUT(X + I, Y + J),PATTERN0,PSET : GOTO 600
  104. 525     PUT(X + I, Y + J),PATTERN1,PSET : GOTO 600
  105. 530     PUT(X + I, Y + J),PATTERN2,PSET : GOTO 600
  106. 535     PUT(X + I, Y + J),PATTERN3,PSET : GOTO 600
  107. 540     PUT(X + I, Y + J),PATTERN4,PSET : GOTO 600
  108. 545     PUT(X + I, Y + J),PATTERN5,PSET : GOTO 600
  109. 550     PUT(X + I, Y + J),PATTERN6,PSET : GOTO 600
  110. 555     PUT(X + I, Y + J),PATTERN7,PSET : GOTO 600
  111. 560     PUT(X + I, Y + J),PATTERN8,PSET : GOTO 600
  112. 565     PUT(X + I, Y + J),PATTERN9,PSET : GOTO 600
  113. 570     PUT(X + I, Y + J),PATTERNA,PSET : GOTO 600
  114. 575     PUT(X + I, Y + J),PATTERNB,PSET : GOTO 600
  115. 580     PUT(X + I, Y + J),PATTERNC,PSET : GOTO 600
  116. 585     PUT(X + I, Y + J),PATTERND,PSET : GOTO 600
  117. 590     PUT(X + I, Y + J),PATTERNE,PSET : GOTO 600
  118. 595     PUT(X + I, Y + J),PATTERNF,PSET : GOTO 600
  119. 600   NEXT J
  120. 605 NEXT I
  121. 610 NEXT JX
  122. 615 WEND
  123. 620 BEEP
  124. 625 GOTO 625
  125. 630 REM                   %%%%%%%%%%%%%%%%%%%%%
  126. 635 REM                   % File I/O Error    %
  127. 640 REM                   % trapping routines %
  128. 645 REM                   %%%%%%%%%%%%%%%%%%%%%
  129. 650 REM
  130. 655 IF ERR = 53 AND ERL = 420 THEN NOTEXISTS% = 1 : RESUME 430
  131. 660 IF ERR = 53 AND ERL = 430 THEN 665 ELSE 670
  132. 665 PRINT FILENAME$," file not found" : END
  133. 670 PRINT "Some error occurred that I was not expecting";ERR,ERL : END
  134. 675 CLOSE #1
  135. 680 IF NOTEXISTS% = 0 THEN 715
  136. 685 REM
  137. 690 REM                   %%%%%%%%%%%%%%%%%%%%%
  138. 695 REM                   % Save the screen   %
  139. 700 REM                   %%%%%%%%%%%%%%%%%%%%%
  140. 705 DEF SEG = &HB800
  141. 710 BSAVE FILESAVE$,0,32767
  142. 715 SCREEN 0
  143. 720 SYSTEM
  144.